home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgLangD.iso / TURBOPASCAL WIN / DOCDEMOS.PAK / MDITEST.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-08  |  3KB  |  138 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo program                                 }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program MDITest;
  10.  
  11. {$R MDITEST.RES}
  12.  
  13. uses WObjects, WinTypes, WinProcs, Strings;
  14.  
  15. const
  16.   cm_CountChildren = 102;
  17.   id_CantClose = 201;
  18.  
  19. type
  20.   TMDIApp = object(TApplication)
  21.     procedure InitMainWindow; virtual;
  22.   end;
  23.  
  24.   PMyMDIChild = ^TMyMDIChild;
  25.   TMyMDIChild = object(TWindow)
  26.     Num: Integer;
  27.     CanCloseCheckBox: PCheckBox;
  28.     constructor Init(AParent: PWindowsObject; ChildNum: Integer);
  29.     procedure SetupWindow; virtual;
  30.     function CanClose: Boolean; virtual;
  31.   end;
  32.  
  33.   PMyMDIWindow = ^TMyMDIWindow;
  34.   TMyMDIWindow = object(TMDIWindow)
  35.     procedure SetupWindow; virtual;
  36.     function CreateChild: PWindowsObject; virtual;
  37.     function GetChildCount: Integer;
  38.     procedure CMCountChildren(var Msg: TMessage);
  39.       virtual cm_First + cm_CountChildren;
  40.   end;
  41.  
  42. { TMyMDIChild's constructor instantiates a checkbox }
  43. constructor TMyMDIChild.Init(AParent: PWindowsObject; ChildNum: Integer);
  44. var
  45.   TitleStr: array[0..12] of Char;
  46.   ChildNumStr: array[0..5] of Char;
  47. begin
  48.   Str(ChildNum, ChildNumStr);
  49.   StrCat(StrECopy(TitleStr, 'Child #'), ChildNumStr);
  50.   TWindow.Init(AParent, TitleStr);
  51.   Num := ChildNum;
  52.   New(CanCloseCheckBox, Init(@Self, id_CantClose, 'Can Close', 10, 10,
  53.     200, 20, nil));
  54. end;
  55.  
  56. { Check the checkbox by default }
  57. procedure TMyMDIChild.SetupWindow;
  58. begin
  59.   TWindow.SetupWindow;
  60.   CanCloseCheckBox^.Check;
  61. end;
  62.  
  63. { CanClose is dependent upon the state of the checkbox }
  64. function TMyMDIChild.CanClose;
  65. begin
  66.   CanClose := CanCloseCheckBox^.GetCheck = bf_Checked;
  67. end;
  68.  
  69. { SetupWindow creates the first MDI child }
  70. procedure TMyMDIWindow.SetupWindow;
  71. var
  72.   ARect: TRect;
  73.   NewChild: PMyMDIChild;
  74. begin
  75.   TMDIWindow.SetupWindow;
  76.   CreateChild;
  77. end;
  78.  
  79.  
  80. { Create a new MDI child }
  81. function TMyMDIWindow.CreateChild: PWindowsObject;
  82. var
  83.   ChildNum: Integer;
  84.  
  85.   function NumberUsed(P: PMyMDIChild): Boolean; far;
  86.   begin
  87.     NumberUsed := ChildNum = P^.Num;
  88.   end;
  89.  
  90. begin
  91.   ChildNum := 1;
  92.   while FirstThat(@NumberUsed) <> nil do Inc(ChildNum);
  93.   CreateChild := Application^.MakeWindow(New(PMyMDIChild,
  94.     Init(@Self, ChildNum)));
  95. end;
  96.  
  97. { Return a count of the MDI children }
  98. function TMyMDIWindow.GetChildCount: Integer;
  99. var
  100.   Count: Integer;
  101.  
  102.   procedure CountChild(AChild: PWindowsObject); far;
  103.   begin
  104.     Inc(Count);
  105.   end;
  106.  
  107. begin
  108.   Count := 0;
  109.   ForEach(@CountChild);
  110.   GetChildCount := Count;
  111. end;
  112.  
  113. { Display a message box which shows the number of children }
  114. procedure TMyMDIWindow.CMCountChildren(var Msg: TMessage);
  115. var
  116.   CountStr: array[0..5] of Char;
  117. begin
  118.   Str(GetChildCount, CountStr);
  119.   MessageBox(HWindow, CountStr, 'Total Children', mb_Ok);
  120. end;
  121.  
  122. { Construct a main window object }
  123. procedure TMDIApp.InitMainWindow;
  124. begin
  125.   MainWindow := New(PMyMDIWindow,
  126.     Init('MDI Conformist', LoadMenu(HInstance, MakeIntResource(100))));
  127.   HAccTable := LoadAccelerators(HInstance, MakeIntResource(100));
  128. end;
  129.  
  130. var
  131.   MDIApp: TMDIApp;
  132.  
  133. begin
  134.   MDIApp.Init('MDITest');
  135.   MDIApp.Run;
  136.   MDIApp.Done;
  137. end.
  138.